home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / bbsutil / dlx70bbs.zip / DLX70SRC.ZIP / LOADINIT.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-19  |  6KB  |  245 lines
  1. {$debug-}
  2. {$line-}
  3.  
  4. {$include: 'types.int'}
  5. {$include: 'globals.int'}
  6. {$include: 'utils.int'}
  7. {$include: 'load.int'}
  8. {$include: 'loadinit.int'}
  9.  
  10. IMPLEMENTATION OF loadinit;
  11.  
  12. USES types,globals,utils,load;
  13.  
  14. {DLX Bulletin Board System V7.0
  15.  
  16.  FREEWARE NOTICE
  17.  
  18.  DLX V7.0 is placed in the public domain by its author, Richard Gillmann.
  19.  Anyone who wishes to may run the program, copy it, or modify it for
  20.  any purpose, including commercial gain.}
  21.  
  22. {***Interface to the PASASM assembler utilities package***}
  23. {$include: 'newasm.int'}
  24.  
  25. function get_para(var f : text) : para;
  26. var
  27.   s : lstring(long_line);
  28.   p,tail,top : para;
  29.   i : integer;
  30.   newlines : byte;
  31. begin
  32. {0 lines}
  33.   get_para:=nill;
  34.   top:=nill;
  35.   newlines:=0;
  36.   repeat
  37.     if f.errs<>0 or else eof(f) then return;
  38.     readln(f,s); expand_tabs(s);
  39.   until s.len<3 or else s[1]<>'&' or else s[2]<>'-' or else s[3]<>'-';
  40. {at least one line}
  41.   while s.len<2 or else s[1]<>'&' or else uc(s[2])<>'X' do begin
  42.     if s=null then
  43.       [if newlines<255 then
  44.          newlines:=newlines+1]
  45.     else begin
  46.       p:=newpara(s);
  47.       p^.crlfs:=newlines;
  48.       newlines:=0;
  49.       if top=nill
  50.         then [get_para:=p; top:=p; tail:=p]
  51.     else [tail^.link:=p; tail:=p];
  52.       if not top^.amper then
  53.     for i:=1 to ord(s.len) do
  54.       if s[i]='&' then [top^.amper:=true; break];
  55.     end {if};
  56.     repeat
  57.       if f.errs<>0 or else eof(f) then return;
  58.       readln(f,s); expand_tabs(s);
  59.     until s.len<3 or else s[1]<>'&' or else s[2]<>'-' or else s[3]<>'-';
  60.   end {while};
  61. {possible blank lines at end}
  62.   if newlines>0 then begin
  63.     p:=newpara(null);
  64.     p^.crlfs:=newlines-1;
  65.     if top=nill
  66.       then get_para:=p
  67.       else tail^.link:=p;
  68.   end {if};
  69. end {get_para};
  70.  
  71. function load_qaire(const file_name : lstring) : questions;
  72. var
  73.   f : text;
  74.   qs1,qs2 : questions;
  75.   p : para;
  76.   n : integer;
  77.   str : lstring(30);
  78. begin
  79.   load_qaire:=nil;
  80.   f.trap:=true; f.errs:=0;
  81.   assign(f,file_name); reset(f);
  82.   if f.errs<>0 or else eof(f) then return;
  83.   close(f);
  84.   f.trap:=false;
  85.   assign(f,file_name); reset(f);
  86.   qs1:=nil; n:=0;
  87.   while not eof(f) do begin
  88.     new(qs2); qs2^.link:=nil;
  89.     readln(f,str);
  90.     case str[str.len] of
  91.       'N','n' : [qs2^.kind := num; str.len := str.len-1];
  92.       'A','a' : [qs2^.kind := alf; str.len := str.len-1];
  93.       otherwise qs2^.kind := mult;
  94.     end {case};
  95.     if not decode(str,qs2^.nans) then [dispose(qs2); break];
  96.     if (n+qs2^.nans)>number_of_answers then
  97.       qs2^.nans:=number_of_answers-n;
  98.     n:=n+qs2^.nans;
  99.     qs2^.qna:=get_para(f);  
  100.     if qs1=nil
  101.       then load_qaire:=qs2
  102.       else qs1^.link:=qs2;
  103.     qs1:=qs2;
  104.     if n>=number_of_answers then break;
  105.   end {while};
  106.   close(f);
  107. end {load_qaire};
  108.  
  109. function load_essay(const file_name : lstring) : essays;
  110. var
  111.   f : text;
  112.   qs1,qs2 : essays;
  113.   p : para;
  114.   n : integer;
  115. begin
  116.   load_essay:=nil;
  117.   f.trap:=true; f.errs:=0;
  118.   assign(f,file_name);
  119.   reset(f);
  120.   if f.errs<>0 or else eof(f) then return;
  121.   qs1:=nil;
  122.   n:=0;
  123.   while f.errs=0 and then (not eof(f)) do begin
  124.     new(qs2); qs2^.link:=nil;
  125.     qs2^.qna:=get_para(f);  
  126.     if qs1=nil
  127.       then load_essay:=qs2
  128.       else qs1^.link:=qs2;
  129.     qs1:=qs2;
  130.   end {while};
  131.   close(f);
  132. end {load_essay};
  133.  
  134. procedure load_ss;
  135. var
  136.   f : text;
  137.   i,j : integer;
  138.   str : lstring(10);
  139. begin
  140.   f.trap:=true; f.errs:=0;
  141.   assign(f,'STRINGS');
  142.   reset(f);
  143.   if f.errs<>0 or else eof(f) then
  144.     [writeln('STRINGS file missing'); ret2dos(4)];
  145.   for i:=1 to UPPER(ss) do begin
  146.     if f.errs<>0 or else eof(f) then
  147.       [writeln('Too few strings!'); ret2dos(4)];
  148.     readln(f,ss[i]);
  149.     for j:=1 to ord(ss[i].len) do
  150.       if ss[i][j]='{' then ss[i].len:=wrd(j-1);
  151.     while ss[i].len>0 and then ss[i][ord(ss[i].len)]=' ' do
  152.       ss[i].len:=ss[i].len-1;
  153.   end {for};
  154.   for i:=37 to 39 do {can't version off}
  155.     if ss[i].len=7 and then crc_ls(ss[i])=16#EA31 then ss[i].len:=0;
  156.   if not eof(f) then
  157.     writeln('Too many strings!');
  158.   close(f);
  159. end {load_ss};
  160.  
  161. procedure load_mn;
  162. var
  163.   f : text;
  164.   i,j : integer;
  165.   str : lstring(10);
  166. begin
  167.   f.trap:=true; f.errs:=0;
  168.   assign(f,'MENUS');
  169.   reset(f);
  170.   if f.errs<>0 or else eof(f) then
  171.     [writeln('MENUS file missing'); ret2dos(4)];
  172.   for i:=1 to UPPER(mn) do begin
  173.     if f.errs<>0 or else eof(f) then
  174.       [writeln('Too few menus!'); ret2dos(4)];
  175.     readln(f,mn[i]);
  176.     for j:=1 to ord(mn[i].len) do
  177.       if mn[i][j]='{' then mn[i].len:=wrd(j-1);
  178.   end {for};
  179.   if not eof(f) then
  180.     writeln('Too many menus!');
  181.   close(f);
  182. end {load_mn};
  183.  
  184. procedure load_macros;
  185. var
  186.   f : text;
  187.   s : lstring(long_line);
  188.   p,tail : para;
  189. begin
  190.   macro_txt := nill;
  191.   f.trap:=true; f.errs:=0;
  192.   assign(f,'MACROS');
  193.   reset(f);
  194.   while f.errs=0 and then not eof(f) do begin
  195.     readln(f,s); expand_tabs(s);
  196.     if eq2(s,'&--') then cycle;
  197.     for var i:=1 to ord(s.len)-2 do
  198.       if s[i]='&' and then s[i+1]='-' and then s[i+2]='-' then
  199.         [s.len:=wrd(i-1); break];
  200.     while s.len>0 and then s[s.len]=' ' do s.len:=s.len-1;
  201.     if s.len<4 or else s[1]<>'&' or else s[4]<>'=' then
  202.       [if s=null
  203.          then cycle
  204.          else [writeln; writeln('Bad macro: ',s); ret2dos(4)]];
  205.     s[2]:=uc(s[2]); s[3]:=uc(s[3]);
  206.     p := newpara(s);
  207.     if macro_txt=nill
  208.       then macro_txt:=p
  209.       else tail^.link:=p;
  210.     tail:=p;
  211.   end {while};
  212.   close(f);
  213. end {load_macros};
  214.  
  215. procedure load_script;
  216. var
  217.   f : text;
  218.   i : integer;
  219.   str : lstring(10);
  220.   p : ads of para;
  221. begin
  222.   str:='MULTIPLE.0';
  223.   for i:=1 to number_of_qaires do
  224.     [str[10]:=chr(ord('0')+i);
  225.      qair[i]:=load_qaire(str)];
  226.   essay:=load_essay('ESSAY');
  227.   order:=load_essay('ORDER');
  228.   f.trap:=true; f.errs:=0;
  229.   assign(f,'PROMPTS');
  230.   reset(f);
  231.   if f.errs<>0 or else eof(f) then
  232.     [writeln('PROMPTS file missing'); ret2dos(4)];
  233.   null_txt:=newpara(null);
  234.   p:=ads top_txt;
  235.   while p.r <= (ads pub_del_txt).r do begin
  236.     p^:=get_para(f);
  237.     p.r:=p.r+sizeof(p^);
  238.   end {while};
  239.   if pub_del_txt=nill then
  240.     [writeln('Too few prompts!'); ret2dos(4)];
  241.   close(f);
  242. end {load_script};
  243.  
  244. END.
  245.